home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / lib / perl / 5.10.0 / IPC / Msg.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  4.0 KB  |  229 lines
  1. # IPC::Msg.pm
  2. #
  3. # Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package IPC::Msg;
  8.  
  9. use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
  10. use strict;
  11. use vars qw($VERSION);
  12. use Carp;
  13.  
  14. $VERSION = "1.02";
  15. $VERSION = eval $VERSION;
  16.  
  17. {
  18.     package IPC::Msg::stat;
  19.  
  20.     use Class::Struct qw(struct);
  21.  
  22.     struct 'IPC::Msg::stat' => [
  23.     uid    => '$',
  24.     gid    => '$',
  25.     cuid    => '$',
  26.     cgid    => '$',
  27.     mode    => '$',
  28.     qnum    => '$',
  29.     qbytes    => '$',
  30.     lspid    => '$',
  31.     lrpid    => '$',
  32.     stime    => '$',
  33.     rtime    => '$',
  34.     ctime    => '$',
  35.     ];
  36. }
  37.  
  38. sub new {
  39.     @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )';
  40.     my $class = shift;
  41.  
  42.     my $id = msgget($_[0],$_[1]);
  43.  
  44.     defined($id)
  45.     ? bless \$id, $class
  46.     : undef;
  47. }
  48.  
  49. sub id {
  50.     my $self = shift;
  51.     $$self;
  52. }
  53.  
  54. sub stat {
  55.     my $self = shift;
  56.     my $data = "";
  57.     msgctl($$self,IPC_STAT,$data) or
  58.     return undef;
  59.     IPC::Msg::stat->new->unpack($data);
  60. }
  61.  
  62. sub set {
  63.     my $self = shift;
  64.     my $ds;
  65.  
  66.     if(@_ == 1) {
  67.     $ds = shift;
  68.     }
  69.     else {
  70.     croak 'Bad arg count' if @_ % 2;
  71.     my %arg = @_;
  72.     $ds = $self->stat
  73.         or return undef;
  74.     my($key,$val);
  75.     $ds->$key($val)
  76.         while(($key,$val) = each %arg);
  77.     }
  78.  
  79.     msgctl($$self,IPC_SET,$ds->pack);
  80. }
  81.  
  82. sub remove {
  83.     my $self = shift;
  84.     (msgctl($$self,IPC_RMID,0), undef $$self)[0];
  85. }
  86.  
  87. sub rcv {
  88.     @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
  89.     my $self = shift;
  90.     my $buf = "";
  91.     msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
  92.     return;
  93.     my $type;
  94.     ($type,$_[0]) = unpack("l! a*",$buf);
  95.     $type;
  96. }
  97.  
  98. sub snd {
  99.     @_ <= 4 && @_ >= 3 or  croak '$msg->snd( TYPE, BUF, FLAGS )';
  100.     my $self = shift;
  101.     msgsnd($$self,pack("l! a*",$_[0],$_[1]), $_[2] || 0);
  102. }
  103.  
  104.  
  105. 1;
  106.  
  107. __END__
  108.  
  109. =head1 NAME
  110.  
  111. IPC::Msg - SysV Msg IPC object class
  112.  
  113. =head1 SYNOPSIS
  114.  
  115.     use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
  116.     use IPC::Msg;
  117.  
  118.     $msg = new IPC::Msg(IPC_PRIVATE, S_IRUSR | S_IWUSR);
  119.  
  120.     $msg->snd(pack("l! a*",$msgtype,$msg));
  121.  
  122.     $msg->rcv($buf,256);
  123.  
  124.     $ds = $msg->stat;
  125.  
  126.     $msg->remove;
  127.  
  128. =head1 DESCRIPTION
  129.  
  130. A class providing an object based interface to SysV IPC message queues.
  131.  
  132. =head1 METHODS
  133.  
  134. =over 4
  135.  
  136. =item new ( KEY , FLAGS )
  137.  
  138. Creates a new message queue associated with C<KEY>. A new queue is
  139. created if
  140.  
  141. =over 4
  142.  
  143. =item *
  144.  
  145. C<KEY> is equal to C<IPC_PRIVATE>
  146.  
  147. =item *
  148.  
  149. C<KEY> does not already  have  a  message queue
  150. associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
  151.  
  152. =back
  153.  
  154. On creation of a new message queue C<FLAGS> is used to set the
  155. permissions.  Be careful not to set any flags that the Sys V
  156. IPC implementation does not allow: in some systems setting
  157. execute bits makes the operations fail.
  158.  
  159. =item id
  160.  
  161. Returns the system message queue identifier.
  162.  
  163. =item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
  164.  
  165. Read a message from the queue. Returns the type of the message read.
  166. See L<msgrcv>.  The  BUF becomes tainted.
  167.  
  168. =item remove
  169.  
  170. Remove and destroy the message queue from the system.
  171.  
  172. =item set ( STAT )
  173.  
  174. =item set ( NAME => VALUE [, NAME => VALUE ...] )
  175.  
  176. C<set> will set the following values of the C<stat> structure associated
  177. with the message queue.
  178.  
  179.     uid
  180.     gid
  181.     mode (oly the permission bits)
  182.     qbytes
  183.  
  184. C<set> accepts either a stat object, as returned by the C<stat> method,
  185. or a list of I<name>-I<value> pairs.
  186.  
  187. =item snd ( TYPE, MSG [, FLAGS ] )
  188.  
  189. Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
  190. See L<msgsnd>.
  191.  
  192. =item stat
  193.  
  194. Returns an object of type C<IPC::Msg::stat> which is a sub-class of
  195. C<Class::Struct>. It provides the following fields. For a description
  196. of these fields see you system documentation.
  197.  
  198.     uid
  199.     gid
  200.     cuid
  201.     cgid
  202.     mode
  203.     qnum
  204.     qbytes
  205.     lspid
  206.     lrpid
  207.     stime
  208.     rtime
  209.     ctime
  210.  
  211. =back
  212.  
  213. =head1 SEE ALSO
  214.  
  215. L<IPC::SysV> L<Class::Struct>
  216.  
  217. =head1 AUTHOR
  218.  
  219. Graham Barr <gbarr@pobox.com>
  220.  
  221. =head1 COPYRIGHT
  222.  
  223. Copyright (c) 1997 Graham Barr. All rights reserved.
  224. This program is free software; you can redistribute it and/or modify it
  225. under the same terms as Perl itself.
  226.  
  227. =cut
  228.  
  229.